home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Education / PC-SiG's World of Education.iso / run / 0298 / watormon.pas < prev   
Pascal/Delphi Source File  |  1985-02-25  |  11KB  |  294 lines
  1. program wator;
  2. {$C-}
  3. {***************************************************************************}
  4. {DECLARE GLOBAL VARIABLES USED BY ALL PROCEDURES}
  5. label start;
  6. var
  7.   fish,sharks,fishmove,sharkmove,starve:array [0..1919]
  8.   of integer;
  9.   nfish,nsharks,fbreed,sbreed,slife:integer;
  10.   i,j,k,l,m,n:integer;
  11.   movup,movdn,movrt,movlt,nmoves,nmeals:integer;
  12.   moveopts:array[1..4] of integer;
  13.   currpos,newpos:integer;
  14.   inchar:char;
  15.   cycle,ncycles:integer;
  16.   sumfish,sumsharks:integer;
  17.   maxfish,minfish,maxsharks,minsharks:integer;
  18.   sharkcycle,fishcycle:array[0..2000] of integer;
  19.   screen1:array [0..1999] of integer absolute $b000:$0000;
  20. {*************************************************************************}
  21. procedure intro; {**AN INTRODUCTION TO THE PROGRAM**}
  22. begin
  23. writeln('This program simulates the planet WATOR as described in Scientific');
  24. writeln('American Computer Recreations column, December, 1984.  WATOR is a');
  25. writeln('toroidal (donut-shaped) planet inhabited by fish and sharks.  The');
  26. writeln('fish feed on a ubiquitous plankton and the sharks feed on the fish.');
  27. writeln('Time passes in discrete jumps or cycles.  During each cycle, fish');
  28. writeln('move randomly to an unoccupied square, and reproduce if old enough.');
  29. writeln('Sharks move to a square occupied by a fish and eat it, if possible,');
  30. writeln('or move to an open square if no meals are available.  Sharks will also');
  31. writeln('breed if old enough, but will starve if they do not eat within a specified');
  32. writeln('period of time.  Parameters selected at the beginning of the run are as');
  33. writeln('follows:');
  34. writeln('  nfish:    Number of fish at start of run-distributed randomly.');
  35. writeln('  nsharks:  Number of sharks at start, also distributed randomly.');
  36. writeln('  fbreed:   Number of cycles a fish must exist before reproducing.');
  37. writeln('  sbreed:   Number of cycles sharks must exist before reproducing.');
  38. writeln('  starve:   Number of cycles a shark has to find food before starving.');
  39. writeln('  ncycles:  Number of cycles for this run (maximum of 2000).');
  40. writeln('On the screen, fish look like a dot (.) and sharks like a "O".');
  41. writeln('After the initial screen is displayed, press any key to start the');
  42. writeln('simulation.  During the run, pressing any key will stop the program,');
  43. writeln('or the run will continue until ncycles is reached.');
  44. writeln('Press any key now to continue.');
  45. end;
  46. {*******************END PROCEDURE INTRO************************************}
  47. {**************************************************************************}
  48. procedure display;
  49. begin
  50. for i:=0 to 1919 do
  51.     begin
  52.     if fish[i]>-1 then screen1[i]:=3886
  53.     else if sharks[i]>-1 then screen1[i]:=3919
  54.       else screen1[i]:=3872;
  55.     sharkmove[i]:=-1;
  56.     end;
  57. end;
  58. {**********************END PROCEDURE DISPLAY*******************************}
  59. {**************************************************************************}
  60. procedure count;
  61. begin
  62. sumfish:=0;sumsharks:=0;
  63.   for i:=0 to 1919 do
  64.       begin
  65.         if fish[i]>-1 then sumfish:=sumfish+1;
  66.         if sharks[i]>-1 then sumsharks:=sumsharks+1;
  67.         end;
  68.   gotoxy(1,25);clreol;
  69.   write('TOTAL FISH=',sumfish:4,'(MAX:',maxfish:4,',MIN:',minfish:4,') TOTAL');
  70.   write(' SHARKS=',sumsharks:4,'(MAX:',maxsharks:4,',MIN:',minsharks:4,') ');
  71.   write(cycle);
  72. end;
  73. {***************************************************************************}
  74. {PROCEDURE INITIALIZES ARRAYS, GETS STARTING PARAMETERS, SETS UP SCREEN*****}
  75. procedure initialize;
  76. begin
  77. cycle:=0;
  78. maxfish:=0;minfish:=0;maxsharks:=0;minsharks:=0;
  79. write ('nfish=? '); readln(nfish);
  80. write('nsharks=? ');readln(nsharks);
  81. write('fbreed=? ');readln(fbreed);
  82. write('sbreed=? ');readln(sbreed);
  83. write('slife=? ');readln(slife);
  84. write('how many cycles? ');readln(ncycles);
  85. for i:=0 to 1919 do
  86.   begin
  87.   fish[i]:=-1;sharks[i]:=-1;fishmove[i]:=-1;sharkmove[i]:=-1;
  88.   starve[i]:=-1;
  89.   end;
  90. for i:=1 to nfish do
  91.   begin
  92.   repeat
  93.   j:=random(1920);
  94.   until fish[j]=-1;
  95.   fish[j]:=random(fbreed);
  96.   end;
  97. for i:=1 to nsharks do
  98.   begin
  99.   repeat
  100.   j:=random(1920);
  101.   until (fish[j]=-1)and(sharks[j]=-1);
  102.   sharks[j]:=random (sbreed);
  103.   starve[j]:=random (slife);
  104.   end;
  105. display;
  106. gotoxy(1,25);
  107. end;
  108. {*****************END PROCEDURE INITIALIZE**********************************}
  109. {}
  110. {*****************PROCEDURE MOVEFISH***************************************}
  111. procedure movefish;
  112. begin
  113. for j:=0 to 23 do begin
  114.   k:=j*80;
  115.   for i:=0 to 80 do begin
  116.     {LOOK THROUGH ARRAY FOR FISH, CHECK IF ALREADY MOVED.  IF NOT, THEN }
  117.     currpos:=i+k;
  118.     if (fish[currpos]>-1) and (fishmove[currpos]=-1) then begin
  119.       if i=0 then movlt:=currpos+79 else movlt:=currpos-1;
  120.       if i=79 then movrt:=currpos-79 else movrt:=currpos+1;
  121.       if j=0 then movup:=currpos+1840 else movup:=currpos-80;
  122.       if j=23 then movdn:=currpos-1840 else movdn:=currpos+80;
  123.       nmoves:=0;
  124.       {LOOK AROUND TO SEE WHERE FISH CAN BE MOVED}
  125.       if (fish[movlt]=-1) and (sharks[movlt]=-1) then begin
  126.         nmoves:=nmoves+1;
  127.         moveopts[nmoves]:=1;
  128.         end;
  129.       if (fish[movrt]=-1) and (sharks[movrt]=-1) then begin
  130.         nmoves:=nmoves+1;
  131.         moveopts[nmoves]:=2;
  132.         end;
  133.       if (fish[movup]=-1) and (sharks[movup]=-1) then begin
  134.         nmoves:=nmoves+1;
  135.         moveopts[nmoves]:=3;
  136.         end;
  137.       if (fish[movdn]=-1) and (sharks[movdn]=-1) then begin
  138.         nmoves:=nmoves+1;
  139.         moveopts[nmoves]:=4;
  140.         end;
  141.       {IF NOWHERE TO GO THEY JUST GET OLDER}
  142.       if nmoves=0 then begin if fish[currpos]=fbreed then fish[currpos]:=0
  143.         else fish[currpos]:=fish[currpos]+1 end
  144.       {OTHERWISE, PICK A MOVE TO MAKE}
  145.       else begin
  146.         l:=random (nmoves)+1;
  147.         case moveopts[l] of
  148.           1:newpos:=movlt;
  149.           2:newpos:=movrt;
  150.           3:newpos:=movup;
  151.           4:newpos:=movdn;
  152.           end; {END CASE STATEMENT}
  153.         {THEN MAKE MOVE, FISH BREEDS IF OLD ENOUGH TO REPRODUCE}
  154.         fishmove[newpos]:=1;
  155.         if fish[currpos]=fbreed then begin
  156.           fish[newpos]:=0;fish[currpos]:=0;end
  157.           else begin fish[newpos]:=fish[currpos]+1;fish[currpos]:=-1;end;
  158.         end;
  159.       end;
  160.     end;
  161.   end;
  162. for i:=0 to 1999 do fishmove[i]:=-1;
  163. end;
  164. {}
  165. {******************END PROCEDURE MOVEFISH***********************************}
  166. {}
  167. procedure movesharks;
  168. begin
  169. for j:=0 to 23 do begin
  170.   k:=j*80;
  171.   for i:=0 to 79 do begin
  172.     currpos:=i+k;
  173.     {LOOK THROUGH ARRAY FOR sharks, CHECK IF ALREADY MOVED.  IF NOT, THEN }
  174.     if (sharks[currpos]>-1) and (sharkmove[currpos]=-1) then begin
  175.       if i=0 then movlt:=currpos+79 else movlt:=currpos-1;
  176.       if i=79 then movrt:=currpos-79 else movrt:=currpos+1;
  177.       if j=0 then movup:=currpos+1840 else movup:=currpos-80;
  178.       if j=23 then movdn:=currpos-1840 else movdn:=currpos+80;
  179.       nmeals:=0;nmoves:=0;
  180.       {LOOK AROUND TO SEE WHERE sharks CAN BE MOVED}
  181.       if fish [movlt]>-1 then begin
  182.         nmeals:=nmeals+1;
  183.         moveopts[nmeals]:=1;
  184.         end;
  185.       if fish [movrt]>-1 then begin
  186.         nmeals:=nmeals+1;
  187.         moveopts[nmeals]:=2;
  188.         end;
  189.       if fish [movup]>-1 then begin
  190.         nmeals:=nmeals+1;
  191.         moveopts[nmeals]:=3;
  192.         end;
  193.       if fish [movdn]>-1 then begin
  194.         nmeals:=nmeals+1;
  195.         moveopts[nmeals]:=4;
  196.         end;
  197. {IF THE SHARK FINDS A FISH TO EAT, THEN PICK ONE, EAT IT, BREED IF POSSIBLE}
  198.       if nmeals>0 then begin
  199.         l:=random(nmeals)+1;
  200.         case moveopts[l] of
  201.           1:newpos:=movlt;
  202.           2:newpos:=movrt;
  203.           3:newpos:=movup;
  204.           4:newpos:=movdn;
  205.           end;
  206.         fish[newpos]:=-1;
  207.         starve[newpos]:=0; sharkmove [newpos]:=1;
  208.         if sharks[currpos]=sbreed then begin
  209.           sharks[newpos]:=0;
  210.           sharks[currpos]:=0; starve [currpos]:=0;
  211.           end
  212.           else begin
  213.           sharks[newpos]:=sharks[currpos]+1;
  214.           sharks[currpos]:=-1; starve [currpos]:=-1;
  215.           end;
  216.         end
  217.         else if starve [currpos]<slife then begin
  218. {IF NO MEALS IN VICINITY, LOOK FOR AN EMPTY SQUARE TO MOVE TO}
  219.           if (sharks[movlt]=-1) then begin
  220.             nmoves:=nmoves+1;
  221.             moveopts[nmoves]:=1;
  222.             end;
  223.           if (sharks[movrt]=-1) then begin
  224.             nmoves:=nmoves+1;
  225.             moveopts[nmoves]:=2;
  226.             end;
  227.           if (sharks[movup]=-1) then begin
  228.             nmoves:=nmoves+1;
  229.             moveopts[nmoves]:=3;
  230.             end;
  231.           if (sharks[movdn]=-1) then begin
  232.             nmoves:=nmoves+1;
  233.             moveopts[nmoves]:=4;
  234.             end;
  235. {IF NOTHING TO EAT AND NO PLACE TO GO, SHARK GETS OLDER}
  236.           if nmoves=0 then begin
  237.               if sharks[currpos]=sbreed then sharks[currpos]:=0
  238.                 else sharks[currpos]:=sharks[currpos]+1;
  239.               starve [currpos]:= starve [currpos]+1;
  240.             end
  241. {}
  242. {IF THERE IS A MOVE TO MAKE, PICK ONE FROM AVAILABLE SQUARES}
  243.           else begin
  244.             l:=random (nmoves)+1;
  245.             case moveopts[l] of
  246.               1:newpos:=movlt;
  247.               2:newpos:=movrt;
  248.               3:newpos:=movup;
  249.               4:newpos:=movdn;
  250.               end;
  251.             sharkmove[newpos]:=1;
  252.             starve[newpos]:=starve[currpos]+1;
  253.             if sharks[currpos]=sbreed then begin
  254.               sharks[newpos]:=0;
  255.               sharks[currpos]:=0; starve[currpos]:=0; end
  256.               else begin
  257.               sharks[newpos]:=sharks[currpos]+1;
  258.               sharks[currpos]:=-1;starve[currpos]:=-1; end;
  259.             end;
  260.           end
  261.         else begin
  262.           sharks [currpos]:=-1; starve [currpos]:=-1;
  263.           end;
  264.       end;
  265.     end;
  266.   end;
  267. for i:=0 to 1999 do sharkmove[i]:=-1;
  268. end;
  269. {}
  270. {*********************END PROCEDURE MOVESHARKS******************************}
  271. {}
  272. {*********************BEGINNING OF MAIN PROGRAM*****************************}
  273. begin
  274. intro; repeat until keypressed; read (kbd,inchar);
  275. start:clrscr;initialize;count;
  276. maxfish:=sumfish;minfish:=sumfish;maxsharks:=sumsharks;minsharks:=sumsharks;
  277. fishcycle[0]:=sumfish;sharkcycle[0]:=sumsharks;
  278. repeat until keypressed;
  279. read (kbd,inchar);
  280. repeat
  281.   movefish;
  282.   movesharks;
  283.   display;
  284.   if sumfish>maxfish then maxfish:=sumfish
  285.     else if sumfish<minfish then minfish:=sumfish;
  286.   if sumsharks>maxsharks then maxsharks:=sumsharks
  287.     else if sumsharks<minsharks then minsharks:=sumsharks;
  288.   cycle:=cycle+1;
  289.   count;fishcycle[cycle]:=sumfish;sharkcycle[cycle]:=sumsharks;
  290. until keypressed or (cycle=ncycles); read(kbd,inchar);
  291. clrscr;
  292. write('DO YOU WANT TO DO ANOTHER RUN? (Y/N): ');readln(inchar);
  293. if upcase(inchar)='Y' then goto start;
  294. end.